home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0016_Another Circle Routine.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  1.3 KB  |  72 lines
  1. {
  2. MIKE BURNS
  3.  
  4. > does someone have a circle routine for the 320x200x256 mode. I need one
  5. > using the assembler...  (FAST) ( or isn't that possible) I doesn't need to
  6. > be very perfect, if it has the shape of a circle, I'm satisfied.
  7. }
  8.  
  9. PROCEDURE SWAP(VAR A, B : Integer);
  10. Var
  11.   X : Integer;
  12. Begin
  13.   X := A;
  14.   A := B;
  15.   B := X;
  16. End;
  17.  
  18. Var
  19.   SCR : Array [0..199, 0..319] of Byte Absolute $A000 : $0000;
  20.  
  21. PROCEDURE Circle(X, Y, Radius : Word; Color: Byte);
  22. VAR
  23.   a, af, b, bf,
  24.   target, r2   : Integer;
  25. Begin
  26.   Target := 0;
  27.   A  := Radius;
  28.   B  := 0;
  29.   R2 := Sqr(Radius);
  30.  
  31.   While a >= B DO
  32.   Begin
  33.     b:= Round(Sqrt(R2 - Sqr(A)));
  34.     Swap(Target, B);
  35.     While B < Target Do
  36.     Begin
  37.       Af := (120 * a) Div 100;
  38.       Bf := (120 * b) Div 100;
  39.       SCR[x + af, y + b] := color;
  40.       SCR[x + bf, y + a] := color;
  41.       SCR[x - af, y + b] := color;
  42.       SCR[x - bf, y + a] := color;
  43.       SCR[x - af, y - b] := color;
  44.       SCR[x - bf, y - a] := color;
  45.       SCR[x + af, y - b] := color;
  46.       SCR[x + bf, y - a] := color;
  47.       B := B + 1;
  48.     End;
  49.     A := A - 1;
  50.   End;
  51. End;
  52.  
  53. begin
  54.   Asm
  55.     Mov ax, $13
  56.     Int $10;
  57.   end;
  58.  
  59.   Circle(50, 50, 40, $32);
  60.   Readln;
  61.  
  62.   Asm
  63.     Mov ax, $03
  64.     Int $10;
  65.   end;
  66. end.
  67.  
  68.  
  69.  
  70.  
  71.  
  72.